home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: delta / whiteline CD Series - delta.iso / progtool / modula2 / module / windowdi.mod < prev    next >
Encoding:
Modula Implementation  |  1995-11-25  |  9.6 KB  |  286 lines
  1. IMPLEMENTATION MODULE  WindowDialogue;
  2.  
  3. FROM SYSTEM IMPORT WORD,VAL,ADDRESS,ADR,TSIZE,SHIFT;
  4.  
  5. FROM EasyWindow IMPORT rectangle,windowtype,RedrawProcType,wstring,
  6.                        windowlist,WindowElements,
  7.                        createWindow,WindowElement,openWindow,
  8.                        closeWindow,deleteWindow;
  9.  
  10. FROM EasyDial IMPORT SetObjectXYWH,DoMoveDialog,GetObjectFlags,GetObjectTail,
  11.                      WorkTree,TreePROC,GetBoxColor,GetObjectState,InitCheckBoxes,
  12.                      FormKeyboard,FormButton,GetObjectXYWH;
  13.  
  14.  
  15. FROM AES IMPORT ObjectDraw,FormCenter,EventMultiple,WindowFind,ObjectEdit,
  16.                 WindowGet,ObjectFind,ApplWrite,WindowCalc,ApplTPlayback,
  17.                 ObjectChange;
  18. FROM GEMAESbase  IMPORT MesageEvent,TimerEvent,KeyboardEvent,Editable,
  19.                         WorkXYWH,Object,Crossed,Checked,Black,Selected,
  20.                         ButtonEvent,Top,WCBorder,Default,TouchExit,Exit,
  21.                         Selectable,GraphicButton;
  22. FROM XBIOS104   IMPORT KeyTable,SetKeyTable, KeyTablePtr,KeyTrans,KeyTransPtr;
  23.  
  24.  
  25.  
  26. VAR DefaultObject,ButtonIndex,
  27.     SizeOfObj : INTEGER;
  28.     MessageBuffer  : ARRAY [0..7] OF INTEGER;
  29.     ch        : CHAR;
  30.  
  31.  
  32. PROCEDURE and(a,b:WORD):BOOLEAN;
  33. VAR c: BITSET;
  34. BEGIN
  35.   c:=VAL(BITSET,a)*VAL(BITSET,b);
  36.   IF c<>VAL(BITSET,0) THEN RETURN TRUE
  37.                       ELSE RETURN FALSE;
  38.   END(*IF*);
  39. END and;
  40.  
  41. PROCEDURE FindLastButtonCapChar(TreePtr :ADDRESS; Index :INTEGER);
  42. VAR     Probe   : POINTER TO Object;
  43.         s       : POINTER TO ARRAY [0..40] OF CHAR;
  44.         j       : INTEGER;
  45. BEGIN
  46.     Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObj));
  47.     IF (Probe^.type = GraphicButton)
  48.         AND and(Probe^.flags,Selectable) THEN
  49.         s:=Probe^.spec;
  50.         j:=-1;
  51.         REPEAT
  52.            j:= j+1
  53.         UNTIL (s^[j]=0C) OR (s^[j]=ch);
  54.         IF s^[j]#0C THEN
  55.             ButtonIndex:=Index;
  56.         END(*IF*);
  57.     END(*IF*);
  58. END FindLastButtonCapChar;
  59.  
  60. PROCEDURE DrawWindowDial(window :INTEGER; r:rectangle);
  61. VAR win : windowtype;
  62. BEGIN
  63.   IF (windowlist[window]#NIL) THEN
  64.     win:=windowlist[window]^;
  65.     IF win.opened THEN
  66.        SetObjectXYWH(0,win.reference,win.work.x+1,win.work.y+1,win.work.w,win.work.h);
  67.        ObjectDraw(win.reference,0,8,r.x,r.y,r.w,r.h);
  68.     END(*IF*);
  69.   END(*IF*);
  70. END DrawWindowDial;
  71.  
  72. PROCEDURE OpenWindowDial(TreePtr : ADDRESS;Title :ARRAY OF CHAR):INTEGER;
  73. VAR Window :INTEGER;
  74.     OK : BOOLEAN;
  75.     r :rectangle;
  76. BEGIN
  77.     Window:=CreateDialWindow(TreePtr,Title);
  78.     IF Window >0 THEN
  79.        OK:=OpenDialWindow(Window);
  80.        WindowGet(0,4,r.x,r.y,r.w,r.h);
  81.        DrawWindowDial(Window,r);
  82.     END(*IF*);
  83.     RETURN Window
  84. END  OpenWindowDial;
  85.  
  86. (*PROCEDURE FindExit(TreePtr:ADDRESS; Index:INTEGER);
  87. VAR DiaObject : POINTER TO Object;
  88. BEGIN
  89.     DiaObject:=TreePtr+ VAL(ADDRESS,(Index*SizeOfObj));
  90.     IF and(DiaObject^.flags,Exit) THEN
  91.        ExitObject:=Index;
  92.     END(*IF*);
  93. END FindExit;*)
  94.  
  95. PROCEDURE FindDefault(TreePtr:ADDRESS; Index:INTEGER);
  96. VAR DiaObject : POINTER TO Object;
  97. BEGIN
  98.     DiaObject:=TreePtr+ VAL(ADDRESS,(Index*SizeOfObj));
  99.     IF and(DiaObject^.flags,Default) THEN
  100.        DefaultObject:=Index;
  101.     END(*IF*);
  102. END FindDefault;
  103.  
  104.  
  105.  
  106. PROCEDURE DoWindowDial(ID, Window : INTEGER; TreePtr : ADDRESS;
  107.                        EditObject :INTEGER):INTEGER;
  108.  
  109. CONST
  110.     ROOT =0;
  111.     MAXDEPTH=8;
  112.     EDINIT=1;
  113.     EDCHAR=2;
  114.     EDEND=3;
  115.  
  116. VAR pKeyTable :KeyTablePtr;
  117.     pKeyTa, KbdShift: KeyTransPtr;
  118.  
  119. VAR x,y,w,h :CARDINAL;
  120.     Play : ARRAY [0..3] OF INTEGER;
  121.     i,j,obj,mx,my,pos,button,cli,leave,event :INTEGER;
  122.     ExitObjectState :INTEGER;
  123.     msg : ARRAY [0..7] OF INTEGER;
  124.     SpKey,key,NewPos : INTEGER;
  125.     specstr,buffer : ADDRESS;
  126.     SeekButton     : TreePROC;
  127.     IsDefault : TreePROC;
  128.  
  129. BEGIN
  130.  IF Window>0 THEN
  131.    DefaultObject:=-1;
  132.    IsDefault:=FindDefault;
  133.    WorkTree(TreePtr,0,0,IsDefault);
  134.    pKeyTa:=VAL(ADDRESS,-1);
  135.    pKeyTable:=SetKeyTable( pKeyTa, pKeyTa, pKeyTa);
  136.    KbdShift:=pKeyTable^.shift;
  137.    SeekButton:= FindLastButtonCapChar;
  138.    GetObjectXYWH(ROOT,TreePtr,x,y,w,h);
  139.    leave :=1;
  140.    IF EditObject>0 THEN
  141.       ObjectEdit(TreePtr,EditObject,0,pos,EDINIT,NewPos);
  142.       (* Cursor einschalten *)
  143.    END(*IF*);
  144.    WHILE leave>0 DO
  145.        event := EventMultiple(KeyboardEvent+ButtonEvent+MesageEvent+TimerEvent
  146.                               ,2,1,1,
  147.                               0,0,0,0,0,0,0,0,0,0,
  148.                               ADR(MessageBuffer),10000,0,(* Timer Event*)
  149.                               mx,my,button,SpKey,key,cli);
  150.        pos := NewPos;
  151.        IF and(event,ButtonEvent) THEN
  152.           obj:=ObjectFind(TreePtr,ROOT,MAXDEPTH,mx,my);
  153.           IF obj >0 THEN
  154.              (* Ist es eine Checkbox ? *)
  155.              IF (GetObjectFlags(obj,TreePtr)=Selectable) AND
  156.                 (GetObjectState(TreePtr,obj)=Checked+Selected) AND
  157.                 (GetBoxColor(obj,TreePtr)=Black) THEN
  158.                       ObjectChange(TreePtr,obj,0,x,y,w,h,Crossed+Selected,1);
  159.              ELSIF (GetObjectFlags(obj,TreePtr)=Selectable) AND
  160.                    (GetObjectState(TreePtr,obj)=Crossed+Selected) AND
  161.                    (GetBoxColor(obj,TreePtr)=Black) THEN
  162.                        ObjectChange(TreePtr,obj,0,x,y,w,h, Checked+Selected,1);
  163.              (* Bei Editierbaren Feldern Cursor wechseln *)
  164.              ELSIF   and(GetObjectFlags(obj,TreePtr),Editable) AND (obj#EditObject) THEN
  165.                 ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
  166.                 EditObject:=obj;
  167.                 ObjectEdit(TreePtr,EditObject,SpKey,pos,EDINIT,NewPos);
  168.              ELSE
  169.                leave := FormButton(TreePtr,obj,cli,obj);
  170.              END(*IF*);
  171.           ELSIF obj < 0 THEN (* Maus wurde ausserhalb des Dialogs betätigt *)
  172.              IF EditObject>0 THEN
  173.                 ObjectEdit(TreePtr,EditObject,0,pos,EDEND,NewPos);
  174.              END(*IF*); (* Cursor ausschalten ! *)
  175.              Play[0]:=0;
  176.              Play[1]:=1;
  177.              Play[2]:=cli;
  178.              Play[3]:=button;
  179.              (* Das Mausereignis nochmals erzeugen für Hauptapplikation *)
  180.              ApplTPlayback(ADR(Play),1,1);
  181.              RETURN 0
  182.           END(*IF*);
  183.         ELSIF  and(event,MesageEvent) THEN
  184.            (* Der Applikation nochmals die message übergeben *)
  185.            ApplWrite(ID,16,ADR(MessageBuffer));
  186.            IF EditObject>0 THEN
  187.               ObjectEdit(TreePtr,EditObject,0,pos,EDEND,NewPos);
  188.            END(*IF*); (* Cursor ausschalten ! *)
  189.            RETURN 0
  190.         ELSIF and(event,TimerEvent) THEN
  191.          (* Do Nothing aber Hin Und wieder sollte ein Event auftreten *)
  192.         ELSIF and(event,KeyboardEvent) THEN
  193.             IF SpKey=08H THEN (* Alternate wurde gedrückt *)
  194.                 ch:=CHR(VAL(INTEGER,KbdShift^[SHIFT(key,-8)]));
  195.                 ButtonIndex:=-1;
  196.                 WorkTree(TreePtr,0,0,SeekButton);
  197.                 IF ButtonIndex #-1 THEN
  198.                    (* Eintrag gefunden !! *)
  199.                     leave := FormButton(TreePtr,ButtonIndex,1,obj);
  200.                 END(*IF*);
  201.             ELSE
  202.               (* Return gedrückt und kein DEFAULT-Object? *)
  203.               IF (DefaultObject=-1) AND ((key =7181(*RETURN*))
  204.                   OR (key=29197(*ENTER*))) THEN
  205.                   (* In TAB-Taste umsetzen *)
  206.                   key := 3849;(* TAB *)
  207.               END(*IF*);
  208.               leave:=FormKeyboard(TreePtr,EditObject,0,key,obj,SpKey);
  209.               IF SpKey >0 THEN
  210.                  ObjectEdit(TreePtr,EditObject,SpKey,pos,EDCHAR,NewPos);
  211.                ELSE
  212.                  IF and(GetObjectFlags(obj,TreePtr),Editable) AND (obj#EditObject)
  213.                  AND (obj<=GetObjectTail(TreePtr,ROOT)) THEN
  214.                    ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
  215.                    EditObject:=obj;
  216.                    ObjectEdit(TreePtr,EditObject,SpKey,pos,EDINIT,NewPos);
  217.                  END(*IF*);
  218.                END(*IF*);
  219.              END(*IF*);
  220.         END(*IF*);
  221.    END(*WHILE*);
  222.    IF (EditObject>0) THEN
  223.       (* Cursor wieder ausschalten falls es Edit-Felder gab *)
  224.       ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
  225.    END(*IF*);
  226.    RETURN obj
  227.  ELSE  (* Es konnte kein Fenster erzeugt werden *)
  228.    RETURN  DoMoveDialog(TreePtr,EditObject);
  229.  END(*IF*);
  230. END DoWindowDial;
  231.  
  232.  
  233.  
  234. PROCEDURE CloseWindowDial(VAR Window : INTEGER);
  235. BEGIN
  236.   IF Window>0 THEN
  237.     CloseDialWindow(Window);
  238.     DeleteDialWindow(Window);
  239.   END(*IF*);
  240. END CloseWindowDial;
  241.  
  242.  
  243. PROCEDURE CreateDialWindow(TreePtr : ADDRESS; TitleStr : ARRAY OF CHAR):INTEGER;
  244. VAR win : windowtype;
  245.     x,y,w,h,xb,yb,wb,hb:INTEGER; window:INTEGER;
  246.     RedrawDial:RedrawProcType;
  247.  
  248. BEGIN
  249.     FormCenter(TreePtr,x,y,w,h);
  250.     InitCheckBoxes(TreePtr);
  251.     RedrawDial:=DrawWindowDial;
  252.     createWindow(window,x,y,w,h,WindowElements{Moveable,Title},TitleStr,TRUE,RedrawDial);
  253.     IF (windowlist[window]#NIL) THEN
  254.          win:=windowlist[window]^;
  255.          WindowCalc(WCBorder,VAL(INTEGER,WindowElements{Moveable,Title}),x,y,w,h,xb,yb,wb,hb);
  256.          win.min.x:=xb;
  257.          win.min.y:=yb;
  258.          win.min.w:=wb;
  259.          win.min.h:=hb;
  260.          win.snap:=TRUE;
  261.          win.reference:=TreePtr;
  262.          windowlist[window]^:=win;
  263.     END(*IF*);
  264.     RETURN window
  265. END  CreateDialWindow;
  266.  
  267. PROCEDURE OpenDialWindow(Window : INTEGER):BOOLEAN;
  268. BEGIN
  269.     openWindow(Window,0,0,0,0);
  270. END  OpenDialWindow;
  271.  
  272. PROCEDURE CloseDialWindow(Window : INTEGER);
  273. BEGIN
  274.    closeWindow(Window);
  275. END  CloseDialWindow;
  276.  
  277. PROCEDURE DeleteDialWindow(VAR Window : INTEGER);
  278. BEGIN
  279.    deleteWindow(Window);
  280.    Window:=-1
  281. END  DeleteDialWindow;
  282.  
  283. BEGIN
  284.  SizeOfObj:=TSIZE(Object)
  285. END  WindowDialogue.
  286.